home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / demo / X11 / gobang / weights.hs < prev    next >
Encoding:
Text File  |  1994-09-27  |  15.2 KB  |  324 lines  |  [TEXT/YHS2]
  1. module Weights where
  2.  
  3. import Xlib
  4. import Utilities
  5.  
  6. xlookup :: XMArray Int -> Int -> Int -> IO Int
  7. xlookup keyboard x y =
  8.       if (x < 1 || x > 19 || y < 1 || y > 19) 
  9.       then return (-2)
  10.       else xMArrayLookup keyboard ((x-1)*19+(y-1))
  11.  
  12.  
  13. draw_unit :: XMArray Int -> XMArray Int -> XMArray Int -> Int -> Int  -> IO()
  14. draw_unit keyboard weight1 weight2 x y = 
  15.   let 
  16.     update_weight :: XMArray Int->Int->Int->Int->Int->Int->Int->IO()
  17.     update_weight weight counter player x y incr_x incr_y 
  18.       | x>=1 && x<=19 && y>=1 && y<=19 && counter<=4 = 
  19.           cpt_weight x y player >>= \wt -> 
  20.             xMArrayUpdate weight ((x-1)*19+(y-1)) wt >>
  21.               update_weight weight (counter+1) player (x+incr_x) (y+incr_y)
  22.                         incr_x incr_y
  23.       | otherwise = return ()
  24. ----------------------------------------------------------------------------
  25.  
  26.     pattern0 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
  27.     pattern0 a b c d e p | a==p && b==p && c==p && d==p && e==p = True
  28.                      | otherwise                            = False
  29. ----------------------------------------------------------------------------
  30.  
  31.     pattern1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool 
  32.     pattern1 a b c d e f p  | (a==0) && (b==p) && (c==p) && (d==p) && (e==p) &&
  33.                               (f==0)     = True
  34.                        | otherwise  = False     
  35. ----------------------------------------------------------------------------
  36.  
  37.     pattern2 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool  
  38.     pattern2 a b c d e p | (a==0 && b==p && c==p && d==p && e==p)||
  39.                            (a==p && b==p && c==p && d==p && e==0) = True 
  40.              | otherwise                              = False     
  41. ----------------------------------------------------------------------------
  42.            
  43.     pattern3 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool  
  44.     pattern3 a b c d e p | (a==0 && b==p && c==p && d==p && e==0) = True
  45.                          | otherwise                              = False 
  46. ----------------------------------------------------------------------------
  47.            
  48.     pattern4 :: Int -> Int -> Int -> Int -> Int ->  Bool  
  49.     pattern4 a b c d p | (a==0 && b==p && c==p && d==p) ||
  50.                          (a==p && b==p && c==p && d==0) = True
  51.                        | otherwise                      = False      
  52. ----------------------------------------------------------------------------
  53.            
  54.     pattern5 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool  
  55.     pattern5 a b c d e f p  | (a==0 && b==p && c==p && d==0 && e==p && 
  56.                                f==0) ||
  57.                               (a==0 && b==p && c==0 && d==p && e==p &&
  58.                                f==0)    = True
  59.                 | otherwise = False     
  60. ----------------------------------------------------------------------------
  61.            
  62.     pattern6 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool  
  63.     pattern6 a b c d e p | (a==0 && b==p && c==p && d==0 && e==p) ||
  64.                            (a==0 && b==p && c==0 && d==p && e==p) || 
  65.                            (a==p && b==p && c==0 && d==p && e==0) || 
  66.                            (a==p && b==0 && c==p && d==p && e==0) = True
  67.              | otherwise = False     
  68. ----------------------------------------------------------------------------
  69.            
  70.     pattern7 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int-> Bool
  71.     pattern7 a b c d e f g p | (a==0 && b==p && c==0 && d==p && e==0 &&
  72.                                  f==p && g==0) = True
  73.                  | otherwise       = False     
  74. ----------------------------------------------------------------------------
  75.            
  76.     pattern8 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool  
  77.     pattern8 a b c d e f p | (a==0 && b==p && c==0 && d==p && e==0 &&
  78.                               f==p) ||
  79.                              (a==p && b==0 && c==p && d==0 && e==p &&
  80.                       f==0) = True 
  81.                            | otherwise = False     
  82. ----------------------------------------------------------------------------
  83.            
  84.     pattern9 :: Int -> Int -> Int -> Int -> Int -> Bool  
  85.     pattern9 a b c d p | (a==0 && b==p && c==p && d==0) = True
  86.                        | otherwise                      = False     
  87. ----------------------------------------------------------------------------
  88.            
  89.     pattern10 :: Int -> Int -> Int -> Int -> Bool  
  90.     pattern10 a b c p | (a==0 && b==p && c==p) ||
  91.                         (a==p && b==p && c==0) = True
  92.                       | otherwise              = False         
  93. ----------------------------------------------------------------------------
  94.            
  95.     pattern11 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool  
  96.     pattern11 a b c d e p | (a==0 && b==p && c==0 && d==p && e==0) = True
  97.                           | otherwise                              = False     
  98. ----------------------------------------------------------------------------
  99.            
  100.     pattern12 :: Int -> Int -> Int -> Int -> Int -> Bool  
  101.     pattern12 a b c d p | (a==0 && b==p && c==0 && d==p) ||
  102.                           (a==p && b==0 && c==p && d==0) = True
  103.                         | otherwise                      = False   
  104. ----------------------------------------------------------------------------
  105.  
  106.     direct1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> 
  107.                Int -> Int -> Int -> Int -> Int -> Int
  108.     direct1 x y pl ptN1 ptN2 ptN3 ptN4 ptN5 pt ptP1 ptP2 ptP3 ptP4 ptP5
  109.       | (pattern0  ptN4 ptN3 ptN2 ptN1 pt pl) ||
  110.         (pattern0  ptN3 ptN2 ptN1 pt ptP1 pl) ||
  111.         (pattern0  ptN2 ptN1 pt ptP1 ptP2 pl) ||
  112.     (pattern0  ptN1 pt ptP1 ptP2 ptP3 pl) ||
  113.         (pattern0  pt ptP1 ptP2 ptP3 ptP4 pl) = 200
  114.       | (pattern1  ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) ||
  115.         (pattern1  ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
  116.         (pattern1  ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) ||
  117.     (pattern1  ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) = 40
  118.       | (pattern2  ptN4 ptN3 ptN2 ptN1 pt pl) ||
  119.         (pattern2  ptN3 ptN2 ptN1 pt ptP1 pl) ||
  120.         (pattern2  ptN2 ptN1 pt ptP1 ptP2 pl) ||
  121.     (pattern2  ptN1 pt ptP1 ptP2 ptP3 pl) = 13
  122.       | (pattern3  ptN3 ptN2 ptN1 pt ptP1 pl) ||
  123.         (pattern3  ptN2 ptN1 pt ptP1 ptP2 pl) ||
  124.         (pattern3  ptN1 pt ptP1 ptP2 ptP3 pl) = 10
  125.       | (pattern4  ptN3 ptN2 ptN1 pt pl) ||
  126.         (pattern4  ptN2 ptN1 pt ptP1 pl) ||
  127.         (pattern4  ptN1 pt ptP1 ptP2 pl) = 8
  128.       | (pattern5  ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) ||
  129.         (pattern5  ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
  130.         (pattern5  ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) || 
  131.         (pattern5  ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) = 9
  132.       | (pattern6  ptN4 ptN3 ptN2 ptN1 pt pl) ||
  133.         (pattern6  ptN3 ptN2 ptN1 pt ptP1 pl) ||
  134.         (pattern6  ptN2 ptN1 pt ptP1 ptP2 pl) ||
  135.         (pattern6  ptN1 pt ptP1 ptP2 ptP3 pl) = 7
  136.       | (pattern7  ptN5 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) ||
  137.         (pattern7  ptN4 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
  138.     (pattern7  ptN3 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) || 
  139.         (pattern7  ptN2 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) ||
  140.         (pattern7  ptN1 pt ptP1 ptP2 ptP3 ptP4 ptP5 pl) = 6   
  141.       | (pattern8  ptN5 ptN4 ptN3 ptN2 ptN1 pt pl) ||
  142.         (pattern8  ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) ||
  143.         (pattern8  ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
  144.         (pattern8  ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) ||
  145.         (pattern8  ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) || 
  146.         (pattern8  pt ptP1 ptP2 ptP3 ptP4 ptP5 pl) = 5
  147.       | (pattern9  ptN2 ptN1 pt ptP1 pl) || 
  148.         (pattern9  ptN1 pt ptP1 ptP2 pl) = 4
  149.       | (pattern10 ptN2 ptN1 pt pl) ||
  150.         (pattern10 ptN1 pt ptP1 pl) ||
  151.         (pattern10 pt ptP1 ptP2 pl) = 2
  152.       | (pattern11 ptN3 ptN2 ptN1 pt ptP1 pl) || 
  153.         (pattern11 ptN2 ptN1 pt ptP1 ptP2 pl) ||
  154.         (pattern11 ptN1 pt ptP1 ptP2 ptP3 pl) = 3
  155.       | (pattern12 ptN3 ptN2 ptN1 pt pl) ||
  156.         (pattern12 ptN2 ptN1 pt ptP1 pl) ||
  157.         (pattern12 ptN1 pt ptP1 ptP2 pl) ||
  158.         (pattern12 pt ptP1 ptP2 ptP3 pl) = 1
  159.       | otherwise = 0
  160. ----------------------------------------------------------------------------
  161.  
  162.     direct2 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> 
  163.                Int -> Int -> Int -> Int -> Int -> Int
  164.     direct2 x y pl ptN1 ptN2 ptN3 ptN4 ptN5 pt ptP1 ptP2 ptP3 ptP4 ptP5
  165.       | (pattern0  ptN4 ptN3 ptN2 ptN1 pt pl) ||
  166.         (pattern0  ptN3 ptN2 ptN1 pt ptP1 pl) ||
  167.         (pattern0  ptN2 ptN1 pt ptP1 ptP2 pl) ||
  168.     (pattern0  ptN1 pt ptP1 ptP2 ptP3 pl) ||
  169.         (pattern0  pt ptP1 ptP2 ptP3 ptP4 pl) = 200
  170.       | otherwise = 0
  171. -----------------------------------------------------------------------------
  172.  
  173.     cpt_weight :: Int -> Int -> Int -> IO Int
  174.     cpt_weight x y player = 
  175.       xMArrayLookup keyboard ((x-1)*19+(y-1)) >>= \(unit) -> 
  176.       if (unit /= 0) 
  177.         then return (-1) 
  178.         else xlookup keyboard x (y-1) >>= \(xyN1) ->
  179.              xlookup keyboard x (y-2) >>= \(xyN2) ->
  180.              xlookup keyboard x (y-3) >>= \(xyN3) ->
  181.          xlookup keyboard x (y-4) >>= \(xyN4) ->
  182.          xlookup keyboard x (y-5) >>= \(xyN5) ->
  183.          xlookup keyboard x (y+1) >>= \(xyP1) ->
  184.          xlookup keyboard x (y+2) >>= \(xyP2) ->
  185.          xlookup keyboard x (y+3) >>= \(xyP3) ->
  186.          xlookup keyboard x (y+4) >>= \(xyP4) ->
  187.          xlookup keyboard x (y+5) >>= \(xyP5) ->
  188.          xlookup keyboard (x-1) y >>= \(xN1y) ->
  189.          xlookup keyboard (x-2) y >>= \(xN2y) ->
  190.              xlookup keyboard (x-3) y >>= \(xN3y) ->
  191.          xlookup keyboard (x-4) y >>= \(xN4y) ->
  192.          xlookup keyboard (x-5) y >>= \(xN5y) ->
  193.          xlookup keyboard (x+1) y >>= \(xP1y) ->
  194.          xlookup keyboard (x+2) y >>= \(xP2y) ->
  195.          xlookup keyboard (x+3) y >>= \(xP3y) ->
  196.          xlookup keyboard (x+4) y >>= \(xP4y) ->
  197.          xlookup keyboard (x+5) y >>= \(xP5y) ->
  198.          xlookup keyboard (x-1) (y-1) >>= \(xN1yN1)->
  199.              xlookup keyboard (x-2) (y-2) >>= \(xN2yN2) ->
  200.              xlookup keyboard (x-3) (y-3) >>= \(xN3yN3) ->
  201.              xlookup keyboard (x-4) (y-4) >>= \(xN4yN4) ->
  202.              xlookup keyboard (x-5) (y-5) >>= \(xN5yN5) ->
  203.              xlookup keyboard (x+1) (y+1) >>= \(xP1yP1) ->
  204.              xlookup keyboard (x+2) (y+2) >>= \(xP2yP2) ->
  205.              xlookup keyboard (x+3) (y+3) >>= \(xP3yP3) ->
  206.              xlookup keyboard (x+4) (y+4) >>= \(xP4yP4) ->
  207.              xlookup keyboard (x+5) (y+5) >>= \(xP5yP5) ->
  208.              xlookup keyboard (x-1) (y+1) >>= \(xN1yP1) -> 
  209.              xlookup keyboard (x-2) (y+2) >>= \(xN2yP2) ->
  210.              xlookup keyboard (x-3) (y+3) >>= \(xN3yP3) -> 
  211.              xlookup keyboard (x-4) (y+4) >>= \(xN4yP4) -> 
  212.              xlookup keyboard (x-5) (y+5) >>= \(xN5yP5) -> 
  213.              xlookup keyboard (x+1) (y-1) >>= \(xP1yN1) -> 
  214.              xlookup keyboard (x+2) (y-2) >>= \(xP2yN2) -> 
  215.              xlookup keyboard (x+3) (y-3) >>= \(xP3yN3) -> 
  216.              xlookup keyboard (x+4) (y-4) >>= \(xP4yN4) -> 
  217.              xlookup keyboard (x+5) (y-5) >>= \(xP5yN5) ->
  218.          return ( (direct1 x y player xyN1 xyN2 xyN3 xyN4 xyN5 player
  219.                            xyP1 xyP2 xyP3 xyP4 xyP5) + 
  220.                   (direct1 x y player xN1y xN2y xN3y xN4y xN5y player
  221.                            xP1y xP2y xP3y xP4y xP5y) +
  222.                       (direct1 x y player xN1yN1 xN2yN2 xN3yN3 xN4yN4 
  223.                    xN5yN5 player xP1yP1 xP2yP2 xP3yP3 xP4yP4
  224.                    xP5yP5) + 
  225.                   (direct1 x y player xN1yP1 xN2yP2 xN3yP3 xN4yP4 
  226.                    xN5yP5 player xP1yN1 xP2yN2 xP3yN3 xP4yN4
  227.                    xP5yN5) )
  228. -----------------------------------------------------------------------------
  229.  
  230. --                        | 1111 && no_block = 20
  231. --              | 1111 && one_block = 13
  232. --              | 111 && no_block = 10
  233. --              | 111 && one_block = 8
  234. --              | 11 1 or 1 11 && no_block = 9
  235. --              | 11 1 or 1 11 && one_block =7
  236. --                        | 1 1 1 && no_block = 6
  237. --              | 1 1 1 && one_block= 5
  238. --              | 11 && no_block = 4
  239. --              | 11 && one_block =2
  240. --              | 1 1 && no_block =3
  241. --              | 1 1 && one_block=1
  242.  
  243.   in
  244.     update_weight weight1 0 1 x y 1    1    >>
  245.     update_weight weight2 0 2 x y 1    1    >>
  246.     update_weight weight1 0 1 x y 1    (-1) >>
  247.     update_weight weight2 0 2 x y 1    (-1) >>
  248.     update_weight weight1 0 1 x y (-1) (-1) >>
  249.     update_weight weight2 0 2 x y (-1) (-1) >>
  250.     update_weight weight1 0 1 x y (-1) 1    >>
  251.     update_weight weight2 0 2 x y (-1) 1    >>
  252.     update_weight weight1 0 1 x y 0    1    >>
  253.     update_weight weight2 0 2 x y 0    1    >>
  254.     update_weight weight1 0 1 x y 0    (-1) >>
  255.     update_weight weight2 0 2 x y 0    (-1) >>
  256.     update_weight weight1 0 1 x y (-1) 0    >>
  257.     update_weight weight2 0 2 x y (-1) 0    >>
  258.     update_weight weight1 0 1 x y 1    0    >>
  259.     update_weight weight2 0 2 x y 1    0    >>
  260.     return ()
  261.  
  262.  
  263. human_unit :: XMArray Int -> Int -> Int  -> IO(Bool)
  264. human_unit keyboard x y =
  265.   let    
  266.     pattern0 :: Int -> Int -> Int -> Int -> Int -> Bool
  267.     pattern0 a b c d e | a==b && b==c && c==d && d==e = True
  268.                    | otherwise                    = False    
  269.              
  270.     direct3 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> 
  271.                Int
  272.     direct3 ptN1 ptN2 ptN3 ptN4 pt ptP1 ptP2 ptP3 ptP4 
  273.       | (pattern0  ptN4 ptN3 ptN2 ptN1 pt) ||
  274.         (pattern0  ptN3 ptN2 ptN1 pt ptP1) ||
  275.         (pattern0  ptN2 ptN1 pt ptP1 ptP2) ||
  276.     (pattern0  ptN1 pt ptP1 ptP2 ptP3) ||
  277.         (pattern0  pt ptP1 ptP2 ptP3 ptP4) = 200
  278.       | otherwise = 0
  279.   in
  280.     xlookup keyboard x y >>= \(xy) ->
  281.     xlookup keyboard x (y-1) >>= \(xyN1) ->
  282.     xlookup keyboard x (y-2) >>= \(xyN2) ->
  283.     xlookup keyboard x (y-3) >>= \(xyN3) ->
  284.     xlookup keyboard x (y-4) >>= \(xyN4) ->
  285.     xlookup keyboard x (y+1) >>= \(xyP1) ->
  286.     xlookup keyboard x (y+2) >>= \(xyP2) ->
  287.     xlookup keyboard x (y+3) >>= \(xyP3) ->
  288.     xlookup keyboard x (y+4) >>= \(xyP4) ->
  289.     xlookup keyboard (x-1) y >>= \(xN1y) ->
  290.     xlookup keyboard (x-2) y >>= \(xN2y) ->
  291.     xlookup keyboard (x-3) y >>= \(xN3y) ->
  292.     xlookup keyboard (x-4) y >>= \(xN4y) ->            
  293.     xlookup keyboard (x+1) y >>= \(xP1y) ->
  294.     xlookup keyboard (x+2) y >>= \(xP2y) ->
  295.     xlookup keyboard (x+3) y >>= \(xP3y) ->
  296.     xlookup keyboard (x+4) y >>= \(xP4y) ->
  297.     xlookup keyboard (x-1) (y-1) >>= \(xN1yN1)->
  298.     xlookup keyboard (x-2) (y-2) >>= \(xN2yN2) ->
  299.     xlookup keyboard (x-3) (y-3) >>= \(xN3yN3) ->
  300.     xlookup keyboard (x-4) (y-4) >>= \(xN4yN4) ->
  301.     xlookup keyboard (x+1) (y+1) >>= \(xP1yP1) ->
  302.     xlookup keyboard (x+2) (y+2) >>= \(xP2yP2) ->
  303.     xlookup keyboard (x+3) (y+3) >>= \(xP3yP3) ->
  304.     xlookup keyboard (x+4) (y+4) >>= \(xP4yP4) ->
  305.     xlookup keyboard (x-1) (y+1) >>= \(xN1yP1) -> 
  306.     xlookup keyboard (x-2) (y+2) >>= \(xN2yP2) ->
  307.     xlookup keyboard (x-3) (y+3) >>= \(xN3yP3) -> 
  308.     xlookup keyboard (x-4) (y+4) >>= \(xN4yP4) -> 
  309.     xlookup keyboard (x+1) (y-1) >>= \(xP1yN1) -> 
  310.     xlookup keyboard (x+2) (y-2) >>= \(xP2yN2) -> 
  311.     xlookup keyboard (x+3) (y-3) >>= \(xP3yN3) -> 
  312.     xlookup keyboard (x+4) (y-4) >>= \(xP4yN4) -> 
  313.     xlookup keyboard (x+1) y >>= \(xP1y) ->
  314.     xlookup keyboard (x+2) y >>= \(xP2y) ->
  315.     xlookup keyboard (x+3) y >>= \(xP3y) ->
  316.     xlookup keyboard (x+4) y >>= \(xP4y) ->
  317.     if ((direct3 xyN1 xyN2 xyN3 xyN4 xy xyP1 xyP2 xyP3 xyP4) +
  318.         (direct3 xN1y xN2y xN3y xN4y xy xP1y xP2y xP3y xP4y) +  
  319.     (direct3 xN1yN1 xN2yN2 xN3yN3 xN4yN4 xy xP1yP1 xP2yP2 xP3yP3 xP4yP4) +
  320.         (direct3 xN1yP1 xN2yP2 xN3yP3 xN4yP4 xy xP1yN1 xP2yN2 xP3yN3 xP4yN4)) 
  321.        >=200 
  322.       then return (True)
  323.       else return (False)
  324.